home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / tool_inc.zip / MOVEFILE.INC < prev    next >
Text File  |  1990-02-28  |  3KB  |  125 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * Copy or Move files; changes time stamps (3-1-89)
  15.  *
  16.  *)
  17.  
  18. (* ------------------------------------------------------------ *)
  19. procedure copy_file(source,dest: string65);
  20.    (* copy a file from one place to another *)
  21.  
  22. const
  23.    bufmax = $8000;   {maximum buffer size}
  24.    extra = $800;     {extra heap to leave free}
  25. var
  26.    avail:    longint;
  27.    bufsize:  word;   {actual buffer size}
  28.    buf:      ^byte;
  29.    ifd:      dos_handle;
  30.    ofd:      dos_handle;
  31.    n,w:      word;
  32.  
  33. begin
  34.    ifd := dos_open(source,open_read);
  35.    if ifd = dos_error then
  36.       exit;
  37.  
  38.    ofd := dos_create(dest);
  39.    if ofd = dos_error then
  40.    begin
  41.       dos_close(ifd);
  42.       exit;
  43.    end;
  44.  
  45.    bufsize := bufmax;
  46.    avail := dos_maxavail-extra;
  47.    if bufsize > avail then
  48.       bufsize := avail;
  49.  
  50.    if avail < 1 then
  51.    begin
  52. (**)
  53.       make_log_entry('Can''t allocate COPY_FILE buffer!',true);
  54. (**)
  55.       exit;
  56.    end;
  57.  
  58.    dos_getmem(buf,bufsize);
  59.  
  60.    repeat
  61.       n := dos_read(ifd,buf^,bufsize);
  62.       dos_write(ofd,buf^,n);
  63.       w := dos_regs.ax;
  64.    until w <> bufsize;
  65.  
  66.    dos_freemem(buf);
  67.    dos_close(ifd);
  68.    dos_close(ofd);
  69.  
  70.    if w <> n then
  71.    begin
  72.       dos_unlink(dest);
  73. (**)
  74.       make_log_entry('Sorry, no disk space for '+dest,true);
  75. (**)
  76. (***
  77.       writeln(^G'DISK FULL!  Copying to ',dest);
  78. ***)
  79.    end;
  80. end;
  81.  
  82.  
  83. (* ------------------------------------------------------------ *)
  84. procedure move_file(source,dest: string65);
  85.    (* move a file from one place to another;  quickly rename if
  86.       possible, otherwise copy and delete.  touches file to make
  87.       file-date = date moved or copied *)
  88. var
  89.    tfd:  file of byte;
  90.    buf:  byte;
  91.  
  92. begin
  93.  
  94. (* try to rename the file (fastest way, only on same device) *)
  95.    assign(tfd,source);
  96.  
  97.    {$i-} rename(tfd,dest); {$i+}
  98.    if ioresult = 0 then
  99.    begin
  100.       (* move worked, touch the file to set last update date/time
  101.          to today's date.  otherwise file may have strange date as
  102.          set by the transfer protocol.  this makes date = date uploaded *)
  103.       {$i-}
  104.          assign(tfd,dest);
  105.          reset(tfd);
  106.          read(tfd,buf);
  107.          seek(tfd,0);
  108.          write(tfd,buf);
  109.          close(tfd);
  110.       {$i-}
  111.  
  112.       if ioresult <> 0 then {couldn't "touch" file} ;
  113.       exit;
  114.    end
  115.    else
  116.  
  117.    (* rename failed, just copy the file and delete original *)
  118.    begin
  119.       copy_file(source,dest);
  120.       dos_unlink(source);
  121.    end;
  122.  
  123. end;
  124.  
  125.